-----------------------------------------------------------------------------
--
-- Module      :  Model
-- Copyright   :
-- License     :  AllRightsReserved
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module Model (
    WeekDay(..),
    Station(..),
    Time(..),
    Visit(..),
    Course(..),
    CourseFragment(..),
    diffInMin ,
    addVisit,
    addCourse,
    findConnection,
    present,
    presentConnections,
    presentStation,
    generateSchedule,
    presentSchedule,
    canBeErased,
    eraseStation,
    eraseCourse,
    nextPointer
) where

import Data.List

data WeekDay = Mon|Tue|Wed|Thu|Fri|Sat|Sun|Invalid deriving (Eq,Show)
data Station = Station {name::String,courses::[Int]}  deriving (Show)
data Time = Time Int Int deriving (Show)
data Visit = Visit {station:: Station, arrival :: Time, departure :: Time} deriving (Show)
data Course = Course {train::String, pointer:: Int, route::[Visit], days:: [WeekDay]} deriving (Show)
data CourseFragment= CourseFragment {course::Course, firstStation::Int, lastStation::Int} deriving(Show)
data ScheduleEntry = ScheduleEntry {seStation:: Station, arrivals:: [TimeAndDays], departures::[TimeAndDays]} deriving(Show)
data TimeAndDays = TimeAndDays {tdTime::Time, tdDays::[WeekDay]} deriving(Show)

instance Eq Station where
    s1==s2               = (name s1) == (name s2)

instance Eq Course where
    k1==k2               = (train k1) == (train k2)

stationNames xs = [name (station x)| x<-xs]
routeCities xs = map name (map station xs)
courseFragmentCities (CourseFragment c f l) =map station (take (f-l) (drop l (route c)))
courseCities (CourseFragment c f l) =map station (route c)
diffInMin (Time h1 m1) (Time h2 m2) = (h1-h2)*60+m1-m2

compareTime (Time h1 m1) (Time h2 m2) = if(h1>h2)
                                        then GT
                                        else if(h1==h2 && m1>m2)
                                             then GT
                                             else if(h1==h2 && m1==m2)
                                                  then EQ
                                                  else LT

addVisit (Course t p r days) (Visit s a d)=if(name s `notElem` stationNames r)
    then Just (Course t p newRoute days)
    else Nothing
    where newRoute = (Visit s a d):r

addCourse xs (Course t p r days) = [ if (name x) `elem` (routeCities r)
                              then Station (name x) (p:courses x)
                              else Station (name x) (courses x) | x<-xs]
stripMaybe :: Maybe Int -> Int
stripMaybe Nothing = 0
stripMaybe (Just x) = x

presentTime (Time a b) = show a++":"++show b
presentTimeAndDay (TimeAndDays t d)= (presentTime t)++" w dniach "++concatMap (\x -> show x++" ") d++"; "

presentSchedule statName s = "Rozkład jazdy dla stacji "++statName++":\n" ++ concatMap presentScheduleEntry s
presentScheduleEntry s = "Stacja "++(name (seStation s))++":\nPrzyjazdy: "++concatMap presentTimeAndDay (arrivals s)++"\nOdjazdy: "++concatMap presentTimeAndDay (departures s)++"\n"

present c = "Kurs - nazwa: "++train c ++ "\nTrasa:\n"++ concatMap presentRoute (reverse (route c))
presentStation s = name s++"\n"
presentRoute v = "Stacja: "++(name (station v))++"; Przyjazd: "++presentTime (arrival v)++"; Odjazd:"++presentTime (departure v)++"\n"
presentConnections cs = "Możliwe połączenia:\n"++concatMap presentConnection cs

presentConnection:: [CourseFragment]-> String
presentConnection []=""
presentConnection c = "Połączenie:\n"++concatMap presentFragment c
presentFragment f= let firstVisit = route (course f)!!firstStation f
                       lastVisit = route (course f)!!lastStation f
                       in "Pociag "++ train (course f)++":\tOdjazd - "++name (station firstVisit)++" "++presentTime (departure firstVisit)
                               ++ "\tPrzyjazd - "++name (station lastVisit)++" "++presentTime (arrival lastVisit)++"\n"


canBeErased :: String -> [Course] -> Bool
canBeErased name k = let usedStations = concatMap (routeCities.route) k
                     in if((find (\x -> x==name) usedStations)==Nothing)
                        then True
                        else False

-- funkcja usuwajaca obiekt
eraseStation :: String -> [Station] -> [Station]
eraseStation stationName s = delete (Station stationName []) s

eraseCourse :: String -> [Course] -> [Course]
eraseCourse courseName k = delete (Course courseName 0 [] []) k

-- założenie - wizyty w kursie są zawsze posortowane od ostatniej do pierwszej.

{-  Algorytm wyszukiwania połączenia:
    1. Weź miasto z którego mamy zacząć szukać oraz miasto do którego jedziemy.
    2. Sprawdź czy istnieją kursy łączące bezpośrednio te 2 miasta.
    3. Jeżeli kurs jest w dobrą stronę - wypisz go
    4. Zwiększ liczbę przesiadek o 1, jeżeli wieksza od maksymalnej - skoncz, posortuj wyniki po czasie przyjazdu do stacji docelowej
    5. Dodaj odwiedzone miasto do listy miast odwiedzonych
    6. dla każdego kursu przejezdzajacego przez miasto: wejdz do niego, przejdz do miasta nastepnego na trasie
    7. wroc do punktu 2 gdzie miasto poczatkowe to aktualne miasto
-}
--trzeba wyciagnac odcinki od miasta w ktorym sie jest do kolejnych miast na
commonCourses (Station n1 c1) (Station n2 c2) courses day = [CourseFragment x n1index n2index | x<-courses ,
                n1index <- [(stripMaybe (elemIndex n1 (routeCities  (route x))))],n2index<-[(stripMaybe (elemIndex n2 (routeCities  (route x))))],
                n1 `elem` routeCities (route x) && n2 `elem` routeCities (route x) && day `elem` days x && n1index > n2index]

findConnection:: Station -> Station -> [Station] -> [Course] -> WeekDay -> Int -> [CourseFragment] -> [[CourseFragment]]
findConnection from to stations allCourses day trainChange visited = let common = commonCourses from to allCourses day
                                                                         findOthers= privateFindConnection stations allCourses day (trainChange-1) to from
                                                                    in if from==to then [] else if trainChange-1<0
                                                                        then if(length common==0) then [] else (visited++common):[]
                                                                        else if(length common==0) then concatMap (findOthers (visited)) (stations \\ nub (from:(concatMap courseCities (visited))))
                                                                                                  else (visited++common):concatMap (findOthers (visited)) (stations \\ nub (from:(concatMap courseCities (visited))))

privateFindConnection:: [Station] -> [Course] -> WeekDay -> Int -> Station->  Station  -> [CourseFragment] -> Station-> [[CourseFragment]]
privateFindConnection stations allCourses day trainChange to from2 visited from  = [ if((length x >0)  && (length y >0) && from2/=from && to/=from) then y else [] | x<-(findConnection from2 from stations allCourses day 0 visited), y<-(findConnection from to stations allCourses day trainChange (visited++x))]

multiLength:: [[CourseFragment]]->Int
multiLength xs = foldl (+) 0 (map length xs)

getStationCourses:: Station -> [Course] -> [Course]
getStationCourses station courseList = filter (\x -> (pointer x) `elem` (courses station)) courseList

generateSchedule:: Station -> [Station] -> [Course] -> [ScheduleEntry]
generateSchedule station stations allCourses = let importantCourses= getStationCourses station allCourses
                                                in let allEntries=concatMap (createSingleEntries station) importantCourses
                                                    in  sortBy (\ x y -> compare (name (seStation x)) (name (seStation y))) (map (mergeEntriesForStation allEntries) (delete station stations))

createEmptyEntry station = ScheduleEntry station [] []

createSingleEntries station course = let stationPosition=stripMaybe (elemIndex (name station) (routeCities (route course)))
                                   in let departureVisits = take stationPosition (route course)
                                          arrivalVisits = drop (stationPosition+1) (route course)
                                          mainVisit = (route course)!!stationPosition
                                    in (map (createArrival (days course) (arrival mainVisit)) arrivalVisits)++(map (createDeparture (days course) (departure mainVisit)) departureVisits)

createArrival days arrivalTime v= ScheduleEntry (station v) [(TimeAndDays arrivalTime days)] []
createDeparture days departureTime v= ScheduleEntry (station v) [] [(TimeAndDays departureTime days)]



mergeEntries::[ScheduleEntry] -> [ScheduleEntry]
mergeEntries ss = []
mergeEntriesForStation ss station =  let importantEntries = filter (\x -> (seStation x)==station) ss
                                        in ScheduleEntry station (sortBy (\ x y -> compareTime (tdTime x) (tdTime y)) (concatMap arrivals importantEntries)) (sortBy (\ x y -> compareTime (tdTime x) (tdTime y)) (concatMap departures importantEntries))

nextPointer c = (foldl bigger 0 (map pointer c))+1

bigger a b = if(a>=b) then a else b

